/**/qout=1;options results;options failat 99;Parse upper arg od ha ra .;OBJ=XfqGetAddress(ra);if XfqSessionUp(OBJ) then do;if ~XfqHoldMailer(OBJ) then do;drop XFQERRORCODE XFQERRORMSG;v=XfqDropObject(OBJ);v=XfqClose();exit;end;end
else do;Say 'Site 'ra' not online, exiting';drop XFQERRORCODE XFQERRORMSG;v=XfqDropObject(OBJ);v=XfqClose();exit;end;id=pragma('ID');xpr.H=0;xpr.C=50;xpr.D=30;xpr.N=0;xpr.F=0;xpr.O=0
parse var ra rd "#" rz ":" rn "/" rf "." rp .;v=sflos();v=souts();cleanup:;v=XfqReleaseMailer(OBJ);v=XfqDropObject(OBJ);v=XfqClose();v=delete('T:f'id);v=delete('T:o'id);exit 0;sFLOS:;Address COMMAND 'LIST >T:f'id od||rz'.'rn'.'rf'.'rp'.?LO quick nohead'
if word(statef("T:f"id),2)=0 then return 0;if ~open('fl',"T:f"id,'R') then return 0;i=0;do while ~eof('fl');L=Upper(strip(space(ReadLn('fl'),1),'B'));if L="" then iterate;i=i+1;ff.i=L;parse var L fln.i.zone"."fln.i.net"."fln.i.node"."fln.i.point"."junk
ft=left(junk,1);if pos(ft,'H C D N F')>0 then ff.i.pr=xpr.ft;else Iterate;end;v=close('fl');if i=0 then return 0;ff.nn=i;do an=1 until an=ff.nn;err=0;fnm=upper(od||ff.an);if ~exists(fnm) then err=1;else if ~Open('ff',fnm,'R') then err=1
if ~err then do;say 'Scanning 'fnm;do while ~eof('ff');L=upper(strip(ReadLn('ff'),'t','d'x));if L="" then Iterate;flg=20;dp=left(L,1);if dp="#" then do;flg=22;L=delstr(L,1,1);end;else if dp="^"|dp="-" then do;flg=21;L=delstr(L,1,1);end
else if dp="@" then do;flg=20;L=delstr(L,1,1);end;if ~exists(L) then Iterate;parse var L x '.' x '.' x '.' x '.' ex;drop x;if ex="" then do;if right(L,3)="TIC" then flg=21;as=gfn(L);p=ff.an.pr;end;else do;tx=upper(left(ex,2))
if datatype(right(ex,1),'n')&(tx="MO"|tx="TU"|tx="WE"|tx="TH"|tx="FR"|tx="SA"|tx="SU") then do;parse var ha hd "#" hz ":" hn "/" hf "." hp;as=UPPER(d2x(65536+hn-fln.an.net,4)||d2x(65536+hf-fln.an.node,4)||'.'ex)
flg=21;p=ff.an.pr;end;else do;as=gfn(L);flg=20;p=ff.an.pr;end;end;drop ex;QUERY.XQ_NAME=L;QUERY.XQ_SITE=OBJ;wn=NULL;wn=XfqFindWork(QUERY);if wn=NULL then do;say 'Sending:'L'['as'] :'ra' Disp:'flg' Pri:'p
v=XfqAddWorkQuick(ra,L,as,p,flg);end;else v=XfqUnlockWork(wn);end;v=close('ff');end;if wn~=NULL then v=XfqDropObject(wn);end;return 0;
sOUTS:;Address COMMAND 'LIST >T:o'id od||rz'.'rn'.'rf'.'rp'.?UT quick nohead';if word(statef("T:o"id),2)=0 then return 0;if ~open('o',"T:o"id,'R') then return 0;do while ~eof('o');of=upper(readln('o'))
if of="" then iterate;parse var of x '.' x '.' x '.' x '.' ex;drop x;if ~qout & ex="OUT" then Iterate;xt=left(ex,1);if pos(xt,'H C D N O')>0 then p=xpr.xt;else Iterate;file=od||of;as=left(date(),2)||compress(time(),":")||".PKT"
flg=21;QUERY.XQ_NAME=file;QUERY.XQ_SITE=OBJ;wn=NULL;wn=XfqFindWork(QUERY);if wn=NULL then do;say 'Sending:'file'['as'] :'ra' Disp:'flg' Pri:'p;v=XfqAddWorkQuick(ra,file,as,p,flg);end
else v=XfqUnlockWork(wn);if wn~=NULL then v=XfqDropObject(wn);end;v=close('o');return 0;gfn: procedure;if LastPos('/',arg(1))~=0 then return SubStr(arg(1),LastPos('/',arg(1))+1)
else if LastPos(':',arg(1))~=0 then return SubStr(arg(1),LastPos(':',arg(1))+1);else return arg(1)
